Code Red: Unpacking Inequality
## | | | 0% | | | 1% | |= | 2% | |== | 2% | |== | 3% | |=== | 4% | |=== | 5% | |==== | 5% | |==== | 6% | |===== | 7% | |====== | 8% | |======= | 10% | |======== | 11% | |======== | 12% | |========= | 12% | |========= | 13% | |========== | 14% | |============ | 17% | |============= | 18% | |============= | 19% | |=============== | 21% | |=============== | 22% | |================ | 23% | |================== | 26% | |=================== | 27% | |=================== | 28% | |==================== | 28% | |==================== | 29% | |====================== | 32% | |======================= | 32% | |======================= | 33% | |======================== | 35% | |========================= | 36% | |========================== | 37% | |=========================== | 39% | |============================ | 40% | |============================= | 41% | |============================== | 43% | |=============================== | 44% | |================================ | 45% | |================================ | 46% | |================================= | 47% | |=================================== | 50% | |===================================== | 52% | |===================================== | 53% | |====================================== | 54% | |======================================== | 57% | |======================================== | 58% | |========================================== | 60% | |=========================================== | 62% | |============================================ | 63% | |============================================= | 65% | |================================================ | 68% | |================================================= | 70% | |================================================== | 72% | |==================================================== | 74% | |===================================================== | 76% | |====================================================== | 78% | |======================================================= | 78% | |======================================================== | 79% | |======================================================== | 80% | |========================================================= | 81% | |========================================================== | 82% | |========================================================== | 83% | |=========================================================== | 84% | |=========================================================== | 85% | |============================================================ | 85% | |============================================================ | 86% | |============================================================= | 87% | |================================================================ | 92% | |=================================================================== | 96% | |==================================================================== | 98% | |======================================================================| 100%## | | | 0% | |.. | 4% | |.... | 9% [unnamed-chunk-7] | |....... | 13% | |......... | 17% [unnamed-chunk-8] | |........... | 22% | |............. | 26% [unnamed-chunk-9] | |................ | 30% | |.................. | 35% [unnamed-chunk-10] | |.................... | 39% | |...................... | 43% [unnamed-chunk-11] | |........................ | 48% | |........................... | 52% [unnamed-chunk-12] | |............................. | 57% | |............................... | 61% [unnamed-chunk-13] | |................................. | 65% | |................................... | 70% [unnamed-chunk-14] | |...................................... | 74% | |........................................ | 78% [unnamed-chunk-15] | |.......................................... | 83% | |............................................ | 87% [unnamed-chunk-16] | |............................................... | 91% | |................................................. | 96% [unnamed-chunk-17] | |...................................................| 100% ## "C:/Program Files/RStudio/resources/app/bin/quarto/bin/tools/pandoc" +RTS -K512m -RTS data_cleaning.knit.md --to html4 --from markdown+autolink_bare_uris+tex_math_single_backslash --output data_cleaning.html --lua-filter "C:\Users\polly\AppData\Local\R\win-library\4.4\rmarkdown\rmarkdown\lua\pagebreak.lua" --lua-filter "C:\Users\polly\AppData\Local\R\win-library\4.4\rmarkdown\rmarkdown\lua\latex-div.lua" --embed-resources --standalone --variable bs3=TRUE --section-divs --template "C:\Users\polly\AppData\Local\R\win-library\4.4\rmarkdown\rmd\h\default.html" --no-highlight --variable highlightjs=1 --include-before-body "C:\Users\polly\AppData\Local\Temp\RtmpyKtKi0\rmarkdown-str174bc19884f31.html" --variable navbar=1 --variable theme=yeti --mathjax --variable "mathjax-url=https://mathjax.rstudio.com/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML" --include-in-header "C:\Users\polly\AppData\Local\Temp\RtmpyKtKi0\rmarkdown-str174bc4c2a6d55.html"## Warning: package 'sf' was built under R version 4.4.2## Warning: package 'tidycensus' was built under R version 4.4.2## | | | 0% | |= | 1% | |= | 2% | |== | 2% | |== | 3% | |=== | 4% | |=== | 5% | |==== | 5% | |==== | 6% | |===== | 7% | |===== | 8% | |====== | 8% | |====== | 9% | |======== | 11% | |========= | 13% | |=========== | 15% | |============ | 18% | |============= | 19% | |=============== | 21% | |================ | 22% | |================= | 24% | |=================== | 27% | |==================== | 29% | |===================== | 30% | |======================= | 33% | |========================= | 36% | |=========================== | 39% | |============================= | 42% | |=============================== | 44% | |================================= | 46% | |=================================== | 49% | |==================================== | 51% | |===================================== | 53% | |====================================== | 55% | |======================================== | 57% | |========================================== | 60% | |============================================ | 63% | |============================================== | 65% | |================================================= | 70% | |================================================== | 72% | |=================================================== | 73% | |===================================================== | 76% | |======================================================= | 78% | |========================================================= | 82% | |========================================================== | 83% | |============================================================ | 86% | |=============================================================== | 89% | |================================================================= | 92% | |================================================================== | 95% | |==================================================================== | 97% | |======================================================================| 100%## Simple feature collection with 6 features and 6 fields
## Geometry type: MULTIPOLYGON
## Dimension: XY
## Bounding box: xmin: -73.9214 ymin: 40.81228 xmax: -73.84726 ymax: 40.85913
## Geodetic CRS: WGS 84
## GEOID NAME variable estimate
## 1 36005009200 Census Tract 92, Bronx County, New York B19013_001 48326
## 2 36005006400 Census Tract 64, Bronx County, New York B19013_001 33207
## 3 36005036501 Census Tract 365.01, Bronx County, New York B19013_001 35882
## 4 36005007900 Census Tract 79, Bronx County, New York B19013_001 31083
## 5 36005024700 Census Tract 247, Bronx County, New York B19013_001 55938
## 6 36005012101 Census Tract 121.01, Bronx County, New York B19013_001 43472
## moe geometry borough
## 1 11015 MULTIPOLYGON (((-73.86034 4... Bronx
## 2 17763 MULTIPOLYGON (((-73.87395 4... Bronx
## 3 7047 MULTIPOLYGON (((-73.88832 4... Bronx
## 4 7336 MULTIPOLYGON (((-73.90823 4... Bronx
## 5 17646 MULTIPOLYGON (((-73.92096 4... Bronx
## 6 9464 MULTIPOLYGON (((-73.89088 4... Bronx# Rename GEOID to geoid
nyc_tracts <- nyc_tracts |>
rename(geoid = GEOID)
# Join redlining data with census tract geometries
redlining_sf <-
nyc_tracts |>
left_join(redlining_snap, by = "geoid")Redlining throughout Boroughs:
# Load required library for spatial aggregation
library(dplyr)
# Aggregate the census tract data to get borough-level geometries
borough_boundaries <- nyc_tracts |>
group_by(borough) |>
summarize(geometry = st_union(geometry), .groups = 'drop')
# Create a color palette for the hrs2020 variable (continuous scale)
pal <- colorNumeric(
palette = "YlOrRd", # Yellow-Orange-Red palette for a gradient effect
domain = redlining_sf$hrs2020, # Define the domain using the hrs2020 variable
na.color = "grey" # Use grey for NA values
)
# Plot the map focusing on redlining scores (`hrs2020`) throughout the boroughs
leaflet(redlining_sf) |>
addTiles() |>
addPolygons(
fillColor = ~pal(hrs2020),
weight = 1,
opacity = 1,
color = "black",
fillOpacity = 0.7,
highlightOptions = highlightOptions(
weight = 2,
color = "#666",
fillOpacity = 0.9,
bringToFront = TRUE
),
label = ~paste0("Census Tract: ", geoid,
"<br>Borough: ", borough,
"<br>Redlining Score (2020): ", hrs2020)
) |>
addPolygons(
data = borough_boundaries,
weight = 3,
color = "black",
fill = FALSE,
opacity = 1,
highlightOptions = highlightOptions(
weight = 5,
color = "#000000",
bringToFront = TRUE
)
) |>
addLabelOnlyMarkers(
data = st_centroid(borough_boundaries),
lng = ~st_coordinates(geometry)[,1],
lat = ~st_coordinates(geometry)[,2],
label = ~borough,
labelOptions = labelOptions(
noHide = TRUE,
direction = 'center',
textOnly = TRUE,
style = list("color" = "black", "font-size" = "16px", "font-weight" = "bold")
)
) |>
addLegend(
pal = pal,
values = ~hrs2020,
opacity = 0.7,
title = "Redlining Score (2020)",
position = "bottomright"
)## Warning: st_centroid assumes attributes are constant over geometriesAverage Redlining score in each borough.
>>>>>> 62dd14529beb9320aeb9abe4bafe13e476f16e1f
class="section level3">
Average Redlining score in each borough:
redlining |>
mutate(
borough = case_when(
fip == 36061 ~ "Manhattan",
fip == 36047 ~ "Brooklyn",
fip == 36081 ~ "Queens",
fip == 36005 ~ "Bronx",
fip == 36085 ~ "Staten Island",
TRUE ~ "Unknown")
) |>
group_by(borough) |>
summarize(avg_redline_score =
mean(hrs2020, na.rm = TRUE)) |>
mutate(borough = fct_reorder(borough, avg_redline_score)) |>
ggplot(aes(x = borough, y = avg_redline_score, fill = borough)) +
geom_point() +
labs(
title = "Average Redlining Score by Borough",
x = "Borough",
y = "Average Redlining Score"
) +
theme_minimal() +
theme(legend.position = "none")
Distribution of Redlining Scores in Boroughs:
redlining |>
mutate(
borough = case_when(
fip == 36061 ~ "Manhattan",
fip == 36047 ~ "Brooklyn",
fip == 36081 ~ "Queens",
fip == 36005 ~ "Bronx",
fip == 36085 ~ "Staten Island",
TRUE ~ "Unknown")
) |>
ggplot(aes(x = borough, y = hrs2020, fill = borough)) +
geom_boxplot() +
labs(
title = "Distribution of Redlining Scores by Borough",
x = "Borough",
y = "Redlining Score"
) +
theme_minimal() +
theme(legend.position = "none")
SNAP Total Household Count in Boroughs:
SNAP |>
separate(
name,
into = c("census_tract", "county", "state"),
sep = "; ",
fill = "right",
remove = FALSE
) |>
mutate(
borough = case_when(
county == "Queens County" ~ "Queens",
county == "Bronx County" ~ "Bronx",
county == "New York County" ~ "Manhattan",
county == "Kings County" ~ "Brooklyn",
county == "Richmond County" ~ "Staten Island",
TRUE ~ "Unknown"
)
) |>
group_by(borough) |>
summarize(
total_household_count = sum(total_ct_households, na.rm = TRUE)
) |>
filter(borough != "Unknown") |>
ggplot(aes(x = borough, y = total_household_count, fill = borough)) +
geom_bar(stat = "identity") +
labs(
title = "Total SNAP-Enrolled Households by Borough",
x = "Borough",
y = "Total Household Count"
) +
theme_minimal() +
theme(legend.position = "none")
SNAP Enrollment Demographics:
SNAP |>
separate(
name,
into = c("census_tract", "county", "state"),
sep = "; ",
fill = "right",
remove = FALSE
) |>
mutate(
borough = case_when(
county == "Queens County" ~ "Queens",
county == "Bronx County" ~ "Bronx",
county == "New York County" ~ "Manhattan",
county == "Kings County" ~ "Brooklyn",
county == "Richmond County" ~ "Staten Island",
TRUE ~ "Unknown"
)
) |>
group_by(borough)## # A tibble: 2,329 × 24
## # Groups: borough [6]
## geoid name census_tract county state ph_snap total_ct_households
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl>
## 1 36061000100 Census Tra… Census Trac… New Y… New … NA 0
## 2 36061000201 Census Tra… Census Trac… New Y… New … 47.6 878
## 3 36061000202 Census Tra… Census Trac… New Y… New … 42.5 3293
## 4 36061000500 Census Tra… Census Trac… New Y… New … NA 0
## 5 36061000600 Census Tra… Census Trac… New Y… New … 54.8 5191
## 6 36061000700 Census Tra… Census Trac… New Y… New … 1 4873
## 7 36061000800 Census Tra… Census Trac… New Y… New … 48.8 4293
## 8 36061000900 Census Tra… Census Trac… New Y… New … 0 864
## 9 36061001001 Census Tra… Census Trac… New Y… New … 3.7 788
## 10 36061001002 Census Tra… Census Trac… New Y… New … 50.5 2483
## # ℹ 2,319 more rows
## # ℹ 17 more variables: ph_with_children <dbl>, ph_no_children <dbl>,
## # ph_below_poverty <dbl>, ph_above_poverty <dbl>, ph_disability <dbl>,
## # ph_no_disability <dbl>, ph_white <dbl>, ph_black <dbl>, ph_aian <dbl>,
## # ph_asian <dbl>, ph_hispanic <dbl>, ph_no_work <dbl>, ph_1_work <dbl>,
## # ph_2_work <dbl>, ph_other_race <dbl>, ph_non_hispanic <dbl>, borough <chr>Grocery Stores in Manhattan, Brooklyn, and Bronx.
# Create the map to plot all grocery stores in Manhattan, Brooklyn, and Bronx
leaflet() |>
addTiles() |>
addCircleMarkers(
data = nyc_healthy_store,
lng = ~longitude,
lat = ~latitude,
radius = 5,
color = "blue",
stroke = FALSE,
fillOpacity = 0.8,
label = ~paste0("Store Name: ", store_name,
"<br>Borough: ", borough,
"<br>ZIP Code: ", zip_code),
labelOptions = labelOptions(
noHide = FALSE,
direction = "auto"
)
) |>
addLegend(
position = "bottomright",
colors = "blue",
labels = "Grocery Store",
title = "Healthy Grocery Stores"
)Redlining Scores and Demographics:
# Create a color palette for the red_grade variable
pal <- colorFactor(
palette = c("green", "blue", "yellow", "red"),
domain = redlining_sf$red_grade
)
# Plot redlining data on a leaflet map
leaflet(redlining_sf) |>
addTiles() |>
addPolygons(
fillColor = ~pal(red_grade),
weight = 1,
opacity = 1,
color = "black",
fillOpacity = 0.7,
highlightOptions = highlightOptions(
weight = 2,
color = "#666",
fillOpacity = 0.9,
bringToFront = TRUE
),
label = ~paste0("Census Tract: ", geoid, "<br>Redlining Interval: ", interval2020, "<br>Redlining Score (2020): ", hrs2020)
) |>
addLegend(
pal = pal,
values = ~red_grade,
opacity = 0.7,
title = "Redlining Category",
position = "bottomright"
)